# This code reproduces Figure 1 from 
# Is the Supreme Court Veering Rightward? The Ebb-and-Flow of Representation
# by Stephen A. Jessee, Neil Malhotra, Maya Sen
# published in PNAS nexus


library(tidyverse)
library(scales)
library(haven)
library(ggtext)

# SET WORKING DIRECTORY TO LOCATION OF CLEANED DATA FILES
#setwd("")

# load in the data
dat2025 <- read_dta("supremecourtsurveydata2025_cleaned.dta")
dat2024 <- read_dta("supremecourtsurveydata2024_cleaned.dta")
dat2023 <- read_dta("supremecourtsurveydata2023_cleaned.dta")
dat2022 <- read_dta("supremecourtsurveydata2022_cleaned.dta")
dat2021 <- read_dta("supremecourtsurveydata2021_cleaned.dta")
dat2020 <- read_dta("supremecourtsurveydata2020_cleaned.dta")

# lists of what to keep and their labels ----------------------------------

# 2020 keep + labels
keep_2020 <- c("fire_gays_per",
               "fire_trans_per",
               "scholarships_per",
               "electoralcollege_per",
               "trump_state_per",
               "daca_per",
               "trump_congress_per",
               "abortion_per",
               "contraceptives_per",
               "cfpb_per")

case_labels_2020 <- c(fire_gays_per = "Firing Gay Employees",
                      fire_trans_per = "Firing Trans Employees",
                      scholarships_per = "Scholarships–Religious Schools",
                      electoralcollege_per = "Electoral College",
                      trump_state_per = "Trump Taxes (State)",
                      daca_per = "DACA",
                      trump_congress_per = "Trump Taxes (Congress)",
                      abortion_per = "Abortion",
                      contraceptives_per = "Contraceptives",
                      cfpb_per = "CFPB")

# 2021 keep + labels
keep_2021 <- c("schoolspeech_per",
               "covidchurch_per",
               "warrants_per",
               "gayadoption_per",
               "unions_per",
               "azcollectballot_per",
               "ncaa_per",
               "azprovballot_per",
               "agencies_per",
               "donors_per",
               "databases_per",
               "juvcrime_per")

case_labels_2021 <- c(schoolspeech_per = "School Free Speech",
                      covidchurch_per = "COVID Restrictions",
                      warrants_per = "Warrants",
                      gayadoption_per = "Gay Adoption",
                      unions_per = "Unions",
                      azcollectballot_per = "Ballot Harvesting",
                      ncaa_per = "NCAA Athletes",
                      azprovballot_per = "Provisional Ballots",
                      agencies_per = "Federal Agencies",
                      donors_per = "Donors",
                      databases_per = "Databases",
                      juvcrime_per = "Juvenile Crime")

# 2022 keep + labels
keep_2022 <- c("execpriv_per",
               "nativeamer_per",
               "clergy_per",
               "schoolprayer_per",
               "terrorism_per",
               "healthcarevax_per",
               "guncontrol_per",
               "smallbizvax_per",
               "schoolchoice_per",
               "abortion_per",
               "immigration_per",
               "flag_per",
               "epa_per",
               "freespeech_per",
               "roe_per")

case_labels_2022 <- c(execpriv_per = "Executive Privilege",
                      nativeamer_per = "Native American Rights",
                      clergy_per = "Religious Freedom (Clergy)",
                      schoolprayer_per = "School Prayer",
                      terrorism_per = "State Secrets / Terror",
                      healthcarevax_per = "Vaccine Mandate (HHS/Healthcare)",
                      guncontrol_per = "Gun Control",
                      smallbizvax_per = "Vaccine Mandate (OSHA/Workplace)",
                      schoolchoice_per = "Religious Schools Funding",
                      abortion_per = "Abortion (Dobbs 15-Week)",
                      immigration_per = "Immigration",
                      flag_per = "Religious Flag",
                      epa_per = "Environmental Protection",
                      freespeech_per = "Free Speech",
                      roe_per = "Overturn Roe?")

# 2023 keep + labels
keep_2023 <- c("copyright_per",
               "affactionpublic_per",
               "affactionprivate_per",
               "fedelections_per",
               "native_per",
               "gerrymandering_per",
               "commerce_per",
               "gaydiscrim_per",
               "religion_per",
               "studentloans_per",
               "unions_per",
               "algorithm_per",
               "socialmedia_per",
               "cleanwater_per")

case_labels_2023 <- c(copyright_per = "Copyright Protection",
                      affactionpublic_per  = "Aff. Action (UNC)",
                      affactionprivate_per = "Aff. Action (Harvard)",
                      fedelections_per = "Election Law",
                      native_per = "Native American Rights",
                      gerrymandering_per   = "Gerrymandering",
                      commerce_per = "Interstate Commerce",
                      gaydiscrim_per = "LGBT Rights",
                      religion_per = "Religious Freedom",
                      studentloans_per = "Student Loans",
                      unions_per = "Unions",
                      algorithm_per = "Sec. 230 (Algorithms)",
                      socialmedia_per = "Sec. 230 (Aiding)",
                      cleanwater_per = "Environmental Protection")

# 2024 keep + labels
keep_2024 <- c( "abortionhosp_per",
                "gunrights_per",
                "opioids_per",
                "admincourts_per",
                "abortion_per",
                "trademark_per",
                "trumpelig_per",
                "nra_per",
                "chevron_per",
                "homeless_per",
                "blocking_per",
                "socmedblock_per",
                "redistricting_per",
                "insurrection_per",
                "trumpimmune_per")

case_labels_2024 <- c(abortionhosp_per = "Abortion (EMTALA)",
                      gunrights_per = "Gun Rights",
                      opioids_per = "Opioids",
                      admincourts_per = "Admin Courts (SEC v. Jarkesy)",
                      abortion_per = "Abortion (Mifepristone)",
                      trademark_per = "Trademark Rights",
                      trumpelig_per = "Trump Eligibility",
                      nra_per = "NRA",
                      chevron_per = "Agency Deference (Chevron)",
                      homeless_per = "Homelessness",
                      blocking_per = "Officials Blocking Users",
                      socmedblock_per = "Federal–Platform Contacts",
                      redistricting_per = "Redistricting",
                      insurrection_per = "Jan 6 Obstruction",
                      trumpimmune_per = "Trump Immunity")

# 2025 keep + your custom labels (used on the graph)
keep_2025 <- c("gunkits_per",
               "transtherapy_per",
               "tiktok_per",
               "vapes_per",
               "porn_per",
               "genderschools_per",
               "gunliability_per",
               "reversedis_per",
               "policeforce_per")

case_labels_2025 <- c(gunkits_per = "Ghost Gun Kits",
                      transtherapy_per  = "Gender-Affirming Care (Minors)",
                      tiktok_per = "TikTok Restrictions",
                      vapes_per = "Flavored E-Cigarettes",
                      porn_per = "Porn Site Age Verification",
                      genderschools_per = "Parent Opt-Out on Gender/Sex Ed",
                      gunliability_per = "Gun Manufacturer Liability",
                      reversedis_per = "Reverse Discrimination Standard",
                      policeforce_per = "Police Use-of-Force Standard")

# which cases are conservative decisions? ---------------------------------

conservative_cases_2020 <- c("scholarships_per",
                             "contraceptives_per",
                             "cfpb_per")

conservative_cases_2021 <- c("schoolspeech_per",
                             "covidchurch_per",
                             "gayadoption_per",
                             "unions_per",
                             "azcollectballot_per",
                             "azprovballot_per",
                             "agencies_per",
                             "donors_per",
                             "databases_per",
                             "juvcrime_per")

conservative_cases_2022 <- c("nativeamer_per",
                             "clergy_per",
                             "schoolprayer_per",
                             "terrorism_per",
                             "guncontrol_per",
                             "smallbizvax_per",
                             "schoolchoice_per",
                             "abortion_per",
                             "flag_per","epa_per","roe_per")

conservative_cases_2023 <- c("affactionpublic_per",
                             "affactionprivate_per",
                             "gaydiscrim_per",
                             "religion_per",
                             "studentloans_per",
                             "unions_per",
                             "algorithm_per",
                             "socialmedia_per",
                             "cleanwater_per")

conservative_cases_2024 <- c("admincourts_per",
                             "trumpelig_per",
                             "nra_per",
                             "chevron_per",
                             "homeless_per",
                             "redistricting_per",
                             "insurrection_per",
                             "trumpimmune_per")

# i found each of these online
conservative_cases_2025 <- c("transtherapy_per",
                             "tiktok_per",
                             "porn_per",
                             "genderschools_per",
                             "gunliability_per",
                             "reversedis_per",
                             "policeforce_per")



# weighting + selection logic functions -----------------------------------

# lookup table for how party IDs are coded in the data
# 1 = Democrats, 2 = Republicans, 3 = Independents
party_codes <- c(D = 1, R = 2, I = 3)

# function: wshare()
# takes in:
#   x = responses for one case
#   w = survey weights
#   g = party variable
#   grp = the party we're filtering for
#   val = which response option we’re counting
# returns:
#   the weighted share of that party choosing that option

wshare <- function(x, w, g, grp, val){
  # filter to valid rows: response is 1 or 2, has a weight, and correct party
  ok <- !is.na(x) & x %in% c(1,2) & !is.na(w) & !is.na(g) & g == grp
  
  # if no one qualifies (e.g., no Republicans answered), just return NA
  if(!any(ok)) return(NA_real_)
  
  # weighted proportion: sum(weights * indicator) / sum(weights)
  sum(w[ok] * (x[ok] == val)) / sum(w[ok])}

# function: compute_year()
# main one for each survey wave
# takes in:
#   dat = dataset for that year
#   keep_vars = the case variables to include
#   case_labels = short labels for plotting
#   year = numeric year 

compute_year <- function(dat, keep_vars, case_labels, year){
  
  # pick only variables that end in _per and are also in the keep list
  per_vars <- names(dat)[str_detect(names(dat), "_per$")] |> intersect(keep_vars)
  
  # for each case variable, calculate party-specific and overall shares
  tibble(case = per_vars) %>%
    rowwise() %>%
    mutate(# weighted share picking option 1, by party
           pD_1 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["D"], 1),
           pI_1 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["I"], 1),
           pR_1 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["R"], 1),
           
           # weighted share picking option 2, by party
           pD_2 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["D"], 2),
           pI_2 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["I"], 2),
           pR_2 = wshare(dat[[case]], dat$weight, dat$pid3_recoded, party_codes["R"], 2),
           
           # overall share of each option (ignoring party)
           # these are for reference and used in the final “Overall” black dots
           pAll_1 = {x <- dat[[case]]
                     w <- dat$weight
                     ok <- !is.na(x) & x %in% c(1,2) & !is.na(w)
                     sum(w[ok] * (x[ok] == 1)) / sum(w[ok])},
           pAll_2 = {x <- dat[[case]]
                     w <- dat$weight
                     ok <- !is.na(x) & x %in% c(1,2) & !is.na(w)
                     sum(w[ok] * (x[ok] == 2)) / sum(w[ok])}) %>%
    ungroup() %>%
    mutate(# figure out which option looks conservative based on D < I < R
           rule1  = (pD_1 < pI_1 & pI_1 < pR_1),
           rule2  = (pD_2 < pI_2 & pI_2 < pR_2),
      
      # allow ties if they happen (same idea as above but with ≤)
      weak1  = (pD_1 <= pI_1 & pI_1 <= pR_1),
      weak2  = (pD_2 <= pI_2 & pI_2 <= pR_2),
      
      # how far apart Rs and Ds are (helps break ties)
      spread1 = pR_1 - pD_1,
      spread2 = pR_2 - pD_2,
      
      # choose the conservative option:
      # prefer an option that passes the rule; if both do, take the bigger gap;
      # if neither does, fall back to the one with the bigger gap anyway
      conservative_option = case_when(
        rule1 & !rule2 ~ 1L,
        rule2 & !rule1 ~ 2L,
        rule1 &  rule2 ~ if_else(spread1 >= spread2, 1L, 2L),
        !rule1 & !rule2 &  weak1 & !weak2 ~ 1L,
        !rule1 & !rule2 & !weak1 &  weak2 ~ 2L,
        !rule1 & !rule2 &  weak1 &  weak2 & (spread1 >= spread2) ~ 1L,
        !rule1 & !rule2 &  weak1 &  weak2 & (spread1 <  spread2) ~ 2L,
        TRUE ~ if_else(spread1 >= spread2, 1L, 2L)),
      
      # collapse to the chosen option
      pD   = if_else(conservative_option == 1L, pD_1, pD_2),
      pI   = if_else(conservative_option == 1L, pI_1, pI_2),
      pR   = if_else(conservative_option == 1L, pR_1, pR_2),
      pAll = if_else(conservative_option == 1L, pAll_1, pAll_2),
      
      year = year,  # for facetting later
      case_label = recode(case, !!!case_labels)) %>%
    
    # final cleanup — only keep what the plotting code actually uses
    select(year, case, case_label, pD, pI, pR, pAll)}


# build plotting data -----------------------------------------------------

# mapping each year to the vector of variable names that should be bolded.
cons_lists <- list("2020" = conservative_cases_2020,
                   "2021" = conservative_cases_2021,
                   "2022" = conservative_cases_2022,
                   "2023" = conservative_cases_2023,
                   "2024" = conservative_cases_2024,
                   "2025" = conservative_cases_2025)

# 1) Compute year-level summaries, then stack them.
# Each compute_year() returns year, case, case_label,
long <- bind_rows(compute_year(dat2025, keep_2025, case_labels_2025, 2025),
                  compute_year(dat2024, keep_2024, case_labels_2024, 2024),
                  compute_year(dat2023, keep_2023, case_labels_2023, 2023),
                  compute_year(dat2022, keep_2022, case_labels_2022, 2022),
                  compute_year(dat2021, keep_2021, case_labels_2021, 2021),
                  compute_year(dat2020, keep_2020, case_labels_2020, 2020)) %>%
  
  # 2) Flag which rows correspond to cases the Court decided in the conservative direction
  mutate(conservative_case = mapply(\(yr, cs) { yr_key <- as.character(yr) # checking row-by-row, whether the case is in that year's conservative list.
        # If the list for that year is empty or missing, nothing gets bolded.
        if (length(cons_lists[[yr_key]]) == 0) return(FALSE)
        cs %in% cons_lists[[yr_key]]},
        year, case),
        
    # 3) Build the display label that can be bolded in the y-axis when needed.
    # We keep raw case_label (plain text) and also a bold-markdown version.
    case_label_bold = if_else(conservative_case, paste0("<b>", case_label, "</b>"), case_label)) %>%
  
  # 4) Within each year, order rows by pAll (Overall) so the y-axis goes low to high
  group_by(year) %>%
  arrange(pAll, .by_group = TRUE) %>%
  mutate(case_f = factor(paste0(year, "__", case_label_bold),
                         # 5) Freeze the facet order by baking the year into the factor level.
                         levels = paste0(year, "__", case_label_bold))) %>%
  ungroup() %>%
  
  # 6) Go from wide to long for plotting: one row per (case, group).
  # 'group' will be one of pD, pI, pR, pAll; 'prop' is the numeric value.
  pivot_longer(c(pD, pI, pR, pAll),
               names_to  = "group",
               values_to = "prop") %>%
  mutate(group = factor(group,
                        levels = c("pD","pI","pR","pAll"),
                        labels = c("Democrats","Independents","Republicans","Overall")))



# plotting ----------------------------------------------------------------

  long %>%
  ggplot(aes(x = prop, y = case_f, color = group)) +
  geom_vline(xintercept = 0.5, linetype = "dotted") +
  geom_point(size = 2.7) +
  scale_x_continuous(labels = label_percent(accuracy = 1), limits = c(0,1)) +
  scale_color_manual(values = c(Democrats = "#2b6cb0",
                                Independents = "#6b7280",
                                Republicans = "#c53030",
                                Overall = "#000000")) +
  scale_y_discrete(labels = function(x) sub("^\\d{4}__", "", x)) +
  labs(title = NULL, x = "", y = NULL, color = NULL) +
  facet_wrap(~year, scales = "free_y", ncol = 2, nrow = 3) +
  theme_bw(base_size = 11) +
  theme(legend.position = "bottom",
        panel.grid.minor = element_blank(),
        strip.background = element_rect(fill = "white"),
        strip.text = element_text(face = "bold"),
        axis.text.y = element_markdown())
